Computer Shopper 121/Computer Shopper 121/Computer Shopper 121.iso/HomeBus/Turbocad/TCW.Z/padwiz.bas

BASIC Source File | 1997-05-05 | 9.2 KB | 395 lines

' This sample program is to illustrate how to create Wizard-like dialogs for TurboCAD 3.0
'
' In this example I explore the possibilities of parametric drawing using scripts in the
' PCB disciplne.
'
' Author    : Mike Cartwright, Tamara Cartwright (updated for 4.0)
' Date        : 10/21/95, 02/06/97
'



' DBAPI Constants
Global Const BrushSolid = 1
Global Const NULL     = 0

' Result is a global variable returned by each page to tell the
' state machine which button was pressed :
Global Const NextID   = 1
Global Const CancelID = 2
Global Const BackID   = 3
Global Const CreateID = 4


Dim Result As Long


Dim Orientation As Long
Dim PadGap      As Double
Dim RowGap         As Double
Dim PadSize        As Double
Dim Offset         As Long
Dim TotalPads    As Long
Dim PadShape    As Long

Sub Main ()
    Dim dActive As Long
     dActive        = TCWDrawingActive ()
    ' Check for valid drawing
    If dActive = NULL Then
        MsgBox "Program requires active drawing. Open any drawing and try again."
        ' Terminate the program
        Stop
    End If


    Orientation = 1      ' Default is Horizontal
    Offset = 0          ' Default is not to offset the one row
    TotalPads = 16        ' Total in each row
    PadGap = 0.25        ' Gap between pads in the row
    RowGap = 0.5        ' Gap between rows
    PadSize    = .125        ' Diameter of pads
    PadShape = 0        ' Circle is 0, Square is 1

    ' State is actually an index to tell which page we are currently on
    Dim State As Long
    Dim LastState As Long
    LastState = 3

    ' Start on the first page
    State = 0

    Do

        ' Page "0" - Which way up Vertical or Horizontal?
        If State = 0 Then
            OrientationDlg
        End If

        ' Page "1" - Total number of Pads per Row and whether offset or not
        If State = 1 Then
            TotalDlg
        End If

        ' Page "2" - Inter-row gap and inter-pad gaps
        If State = 2 Then
            GapDlg
        End If

        ' Page "LastState" - What shape, circle or square? What Size?
        If State = LastState Then
            ShapeDlg
        End If

        If Result = CreateID Then
            CreatePads
            Exit Do
        End If

        If Result = CancelID Then
            MsgBox "The Pad Wizard was cancelled."
            Exit Do
        End If

        If Result = NextID And State < LastState Then
            State = State + 1
        End If

        If Result = BackID And State > 0 Then
            State = State - 1
        End If

    Loop


End Sub

Sub OrientationDlg ()

    Begin Dialog OrientationDialog 31, 32, 185, 96, "Pad Wizard"
        PushButton 104, 79, 35, 14, "&Next>"             ' Button 1
        PushButton 24,  79, 35, 14, "Cancel"             ' Button 2
        '                            "<&Back"
        PushButton 144, 79, 35, 14, "&Finish"            ' Button 4
        GroupBox 1, 75, 183, 1, ""

        GroupBox 100, 12, 72, 48, "Orientation"
        OptionGroup .grp1
            OptionButton 108, 24, 55, 9, "&Vertical"   ' Option 0
            OptionButton 108, 40, 55, 9, "&Horizontal"      ' Option 1

        GroupBox 10, 12, 82, 48, ""
        Text      14, 18, 74, 40, "If the pads run across the page then choose Horizontal. If not, then choose vertical."
    End Dialog

    Dim Dlg1 As OrientationDialog
    Dlg1.grp1 = Orientation
    Result = Dialog(Dlg1)
    if Result = 3 then
        Result = 4
    End If
    Orientation = Dlg1.grp1

End Sub

Sub ShapeDlg ()

    Begin Dialog ShapeDialog 31, 32, 185, 96, "Pad Wizard"
        '                            "&Next>"
        PushButton 24,  79, 35, 14, "Cancel"             ' Button 2
        PushButton 64,  79, 35, 14, "<&Back"             ' Button 3
        PushButton 144, 79, 35, 14, "&Finish"            ' Button 4
        GroupBox 1, 75, 183, 1, ""

        GroupBox 100, 12, 72, 48, "Pad Shape"
        OptionGroup .grp1
            OptionButton 108, 24, 55, 9, "&Circle"   ' Option 0
            OptionButton 108, 40, 55, 9, "&Square"      ' Option 1

        GroupBox 10, 12, 82, 48, "Pad Size"
        Text      14, 21, 74, 30, "This is the diameter or width of each pad:"
        TextBox  14, 42, 50, 12, .size
    End Dialog

    Dim Dlg2 As ShapeDialog
    Dlg2.grp1 = PadShape
    Do
        Dlg2.size = PadSize
        Result = Dialog(Dlg2)
        Result = Result + 1
        PadSize = Dlg2.size

        If Result = CancelID Then
            Exit Do
        End If

        If PadSize > 0.1 And PadSize < 1.0 Then
            Exit Do
        End If

        MsgBox "Pad Size of " & PadSize &" is not in the range [0.1 .. 1.0]"
    Loop

    PadShape = Dlg2.grp1


End Sub


Sub TotalDlg ()

    Begin Dialog TotalDialog 31, 32, 185, 96, "Pad Wizard"
        PushButton 104, 79, 35, 14, "&Next>"             ' Button 1
        PushButton 24,  79, 35, 14, "Cancel"             ' Button 2
        PushButton 64,  79, 35, 14, "<&Back"             ' Button 3
        PushButton 144, 79, 35, 14, "&Finish"            ' Button 4
        GroupBox 1, 75, 183, 1, ""

        GroupBox 100, 12, 72, 48, "Offset Pads"
        OptionGroup .grp1
            OptionButton 108, 24, 55, 9, "DI&P - in line"   ' Option 0
            OptionButton 108, 40, 55, 9, "DI&N - offset"    ' Option 1

        GroupBox 10, 12, 82, 48, "Number of Pads"
        Text      14, 21, 74, 30, "The number of pads in the longest row:"
        TextBox  14, 42, 50, 12, .total
    End Dialog

    Dim Dlg3 As TotalDialog
    Dlg3.grp1 = Offset
    Do
        Dlg3.total = TotalPads
        Result = Dialog(Dlg3)
        TotalPads = Dlg3.total

        If Result = CancelID Then
            Exit Do
        End If

        If TotalPads > 1 And TotalPads < 100 Then
            Exit Do
        End If

        If TotalPads > 100 Then
            MsgBox TotalPads &" is too many pads"
        End If
        If TotalPads < 2 Then
            MsgBox TotalPads &" is too few pads"
        End If
    Loop

    Offset = Dlg3.grp1



End Sub


Sub GapDlg ()

    Begin Dialog GapDialog 31, 32, 185, 96, "Pad Wizard"
        PushButton 104, 79, 35, 14, "&Next>"             ' Button 1
        PushButton 24,  79, 35, 14, "Cancel"             ' Button 2
        PushButton 64,  79, 35, 14, "<&Back"             ' Button 3
        PushButton 144, 79, 35, 14, "&Finish"            ' Button 4
        GroupBox 1, 75, 183, 1, ""

        GroupBox 100, 12, 76, 48, "Pad Gap"
        Text      104, 21, 69, 30, "This is the space between pad centers:"
        TextBox  104, 42, 50, 12, .padg

        GroupBox 10, 12, 82, 48, "Row Gap"
        Text      14, 21, 74, 30, "This is the space between row centers:"
        TextBox  14, 42, 50, 12, .rowg
    End Dialog

    Dim Dlg4 As GapDialog

    Do
        Dlg4.rowg = RowGap
        Dlg4.padg = PadGap
        Result = Dialog(Dlg4)

        PadGap = Dlg4.padg
        RowGap = Dlg4.rowg

        If Result = CancelID Then
            Exit Do
        End If

        If PadGap > PadSize And RowGap > PadSize Then
            Exit Do
        End If
        If PadGap <= PadSize Then
            MsgBox "Pad Gap of " & PadGap & " should be greater than " & PadSize
        End If
        If RowGap <= PadSize Then
            MsgBox "Row Gap of " & RowGap & " should be greater than " & PadSize
        End If
    Loop
End Sub



' Called on "Create" to actually create the graphics and add them
' to the drawing. They are left selected to make it easier to move them.
Sub CreatePads ()
    Dim dActive  As Long

    Dim xc As Double
    Dim yc As Double
    Dim dx1 As Double
    Dim dx2 As Double
    Dim dx3 As Double
    Dim dy1 As Double
    Dim dy2 As Double
    Dim dy3 As Double

    Dim row As Long
    Dim col As Long

    dActive        = TCWDrawingActive ()
    TCWUndoRecordStart dActive, "Create Pads"

    xc = (TCWViewExtentsGetX1() + TCWViewExtentsGetX2())/2.0
    yc = (TCWViewExtentsGetY1() + TCWViewExtentsGetY2())/2.0


    If Orientation = 1 Then     ' Horizontal
        dx1 = PadGap
        dy1 = 0
        dx2 = 0
        dy2 = -RowGap
    Else                        ' Vertical
        dx1 = 0
        dy1 = -PadGap
        dx2 = RowGap
        dy2 = 0
    End If

    ' Move starting point

    xc = xc - dx1*TotalPads/2.0 - dx2/2.0
    yc = yc - dy1*TotalPads/2.0    - dy2/2.0


    For row = 0 to 1
        For col = 0 to TotalPads-1

            ' Call our function which creates a pad
            MakeObject xc + col*dx1 + row*dx2, yc + col*dy1 + row*dy2

        Next col

        ' For the offset option an extra calculation is required when
        ' switching rows to get the next row's start position
        If Offset Then
            TotalPads = TotalPads - 1
            xc = xc + dx1/2.0
            yc = yc + dy1/2.0
        End If

    Next row

    TCWSelectAll
    TCWGroupCreate "Custom Pads"
    TCWUndoRecordEnd dActive

End Sub

Sub MakeObject (ByVal x As Double, ByVal y As Double)

    Dim gP As Long
    Dim g1 As Long
    Dim g2 As Long
    Dim r As Double

    r = PadSize/2.0

    If PadShape = 0 Then

        g1 = TCWCircleCenterAndPoint(x, y, 0#, x-2*r, y, 0# )

    Else

        ' Create the empty rectangle graphic
        g1 = TCWLineRectangle(x-r, y-r, 0#, x+r, y+r, 0#)

    End If

    ' Color is set as R, G, B - this is black
    result = TCWGraphicPropertySet(g1, "PenColor", &H000000 )

    ' Fill Pattern is a style. We know that style 1 is always solid
    result = TCWGraphicPropertySet(g1, "BrushStyle", BrushSolid)

    ' Add the black background of the pad to the pad group

    ' Make the hole 1/3 of the size of the pad unless it is smaller
    ' then a minimum, in which case it is set to that minimum
    r = PadSize/6.0
    If r > 0.0625 Then
        r =    0.0625
    End If


    If PadShape = 0 Then

        ' Create the empty arc graphic
        g2 = TCWCircleCenterAndPoint(x, y, 0#, x-2*r, y, 0# )

    Else

        ' Create the empty rectangle graphic
        g2 = TCWLineRectangle(x-r, y-r, 0#, x+r, y+r, 0#)
    End If

     ' Color is set as R, G, B - this is white
    result = TCWGraphicPropertySet(g2, "PenColor", &H00FFFFFF)

    ' Fill Pattern is a style. We know that style 1 is always solid
    result = TCWGraphicPropertySet(g2, "BrushStyle", BrushSolid)

End Sub